SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00003 1 08-24-9413:45ALL IAN LIN Edit Long String SWAG9408 ÷~╤ 39 3 π{ code to allow input of strings that are wider than the crt orπ the current window. Will scroll the window to allow continued inputππThis is for entering large strings in a smallerπscreen (do you have a monitor that's 255 chars wide???). In any case, I'llπgive it to you now. So long as you make the viewport larger than theπlength limit of the string, you will have no scrolling and no problem. Iπwill simply have to fix the scrolling later. Modify as you wish, you mayπfind it useful. CRT.TPU is required. }πππuses crt;πconst ksins = 128; {insert mode on}πvar kbshift : byte absolute $40:$17; {shift key status}πFunction Getkey:word;πassembler; asmπ xor ah,ahπ int $16πend;πProcedure Beep(Hz,Ms:word);πbeginπ sound(hz);π delay(ms);π nosound;πend;πfunction edstr(var instring;x,y,viewport,color,limit:byte):boolean;πvarπ wmax,wmin:word;π showpos,xmax,ymax,editpos,viewpos,oldx,oldy,oldcolor:byte;π update,insmode:boolean;π editstr:string absolute instring;π key:recordπ ch,scan:byte;π end;πbeginπ wmax:=windmax; {store window}π wmin:=windmin; {store window}π oldcolor:=textattr; {store color}π oldx:=wherex; {store cursor}π oldy:=wherey; {store cursor}π window(1,1,80,25);π window(1,1,80,50);π xmax:=windmax and 255 + 1;π ymax:=windmax shr 8 + 1;π {verify viewport dimensions}π if (y<=ymax) and (x+viewport-1<=xmax) and (viewport<>0) then beginπ edstr:=true;π window(x,y,x+viewport-1,y); {set window}π textattr:=color; {set new color}π viewpos:=1; {init view pos}π editpos:=1; {init edit pos}π clrscr; {clear window}π kbshift:=kbshift or ksins; {force insert}π update:=true;π if editstr[0]>char(limit) then editstr[0]:=char(limit);π repeat {loop until Enter pressed}π {update display}π if update then beginπ gotoxy(1,1);π inc(windmax); {prevents CRT scrolling}π showpos:=viewpos;π while (showpos<=length(editstr)) and (showpos<=viewpos+viewport-1) doπ beginπ write(editstr[showpos]);π inc(showpos);π end;π dec(windmax); {restore window after temporary anti-scroll}π clreol;π end;π update:=true;π gotoxy((editpos-1) mod viewport+1,1); {proper cursor edit pos}π word(key):=getkey; {get key}π insmode:=kbshift and ksins<>0; {check insert mode}π {if insert then flat cursor else block cursor}π case key.ch of {check key char}π 0:case key.scan of {check key scan code}π $47:editpos:=1; {home}π $4B:if editpos<>1 then dec(editpos); {left}π $4D:if (editpos<>limit) and (editpos<>length(editstr)+1) thenπ inc(editpos); {right}π $4F:if length(editstr)=limit then editpos:=limitπ else editpos:=length(editstr)+1; {end}π $53:delete(editstr,editpos,1); {del}π $77:{^Home, del till start of line}π beginπ delete(editstr,1,editpos-1);π editpos:=1;π end;π $75:delete(editstr,editpos,255); {^End, del till end of line}π $73:{^Left, seek word left}π if editpos=1 then update:=falseπ else repeatπ dec(editpos);π until (editpos=1) or (editstr[editpos-1]=' ');π $74:{^Right, seek word right}π if (editpos=limit) or (editpos=length(editstr)+1) thenπ update:=falseπ else repeatπ inc(editpos);π until (editstr[editpos-1]=' ') or (editpos=limit)π or (editpos=length(editstr)+1);π else update:=false; {do not waste time updating screen}π end; {check key scan code}π 8:if editpos>1 then begin {backspace}π dec(editpos);π delete(editstr,editpos,1);π endπ else update:=false;π 32..255:begin {valid chars}π if insmode or (length(editstr)+1=editpos) thenπ {inserted if using insert mode OR if overstrike AND at string end}π if (length(editstr)<>limit) then insert(char(key.ch),editstr,editpos)π else beep(5000,10) {error: string full}π else editstr[editpos]:=char(key.ch); {overstrike char}π if editpos<>limit then inc(editpos); {inc pos within limit}π end; {valid chars}π else update:=false; {do not waste time updating screen}π end; {check key char}ππ {update scroll window}π while editpos<viewpos do dec(viewpos,viewport); {left}π while editpos>=viewpos+viewport do inc(viewpos,viewport); {right}π until key.ch=13; {enter ends loop/input}π textattr:=oldcolor; {minimal screen clean up}π clrscr;π end {valid viewport}π else edstr:=false; {invalid viewport}π windmin:=wmin; {restore window}π windmax:=wmax; {restore window}π textattr:=oldcolor; {restore color}π gotoxy(oldx,oldy); {restore cursor}πend; {edstr}ππVARπ aStr : STRING;ππBEGINπ IF edstr(aStr, { the value to edit }π 10, { Col (x) }π 10, { Row (y) }π 50, { window width max }π 31, { input color }π 100) { maximum length of input }π THEN WriteLn(aStr);πEND.ππ 2 08-24-9413:55ALL RAPHAEL VANNEY Generic Data Entry SWAG9408 «9σ≈ 209 3 π{-----------------------------------------------------------------------------}π{ }π{ SAISIE.PAS - (c) Raphaël VANNEY, 1993 }π{ }π{ Generic data entry unit. }π{ Langage : Borland Pascal 7 }π{ }π{ This unit intends to provide a tool for data entry from a Pascal program, }π{ in a more fancy fashion that what ReadLn allows for. }π{ }π{ I wrote it not because I felt like reinventing the wheel, but rather }π{ because I needed something that was not available for the OS/2 patch of }π{ Borland Pascal. }π{ }π{ As a result, this unit will compile and run DOS, DPMI and OS/2 programs. }π{ }π{ Note : depending on the version of the OS/2 patch you use, this unit }π{ may not work properly (problem with extended keys). }π{ }π{-----------------------------------------------------------------------------}π{$b-,x+}ππ{$IfDef OS2}π {$c Moveable Discardable DemandLoad}π{$EndIf}ππUnit Saisie ;ππInterfaceππUses Objects ;ππConstπ { A few key codes, as returned by LitTouche }π kbTab = 9 ;π kbEntree = 13 ; { enter }π kbRetour = 8 ; { backspace }π kbCtrlEntree = 10 ; { ctrl-enter }π kbEchap = 27 ; { escape }π kbHaut = 18432 ; { up }π kbBas = 20480 ; { down }π kbDroite = 19712 ; { right }π kbGauche = 19200 ; { left }π kbPageHaut = 18688 ; { PgUp }π kbPageBas = 20736 ; { PgDn }π kbFin = 20224 ; { end }π kbDebut = 18176 ; { home }π kbIns = 20992 ;π kbSuppr = 21248 ; { del }ππ kbCtrlD = 4 ;π kbCtrlT = 20 ;π kbCtrlY = 25 ;ππ kbCtrlDroite = 29696 ; { ctrl-right }π kbCtrlGauche = 29440 ; { ctrl-left }ππ Caracteres : Set Of Char = ['a'..'z', 'A'..'Z', #128..#165] ;πππType { TListeChaines is an unsorted collection of PString's }π TListeChaines =π Object(TCollection)π Procedure FreeItem(Item : Pointer) ; Virtual ;π End ;π PListeChaines = ^TListeChaines ;ππ { TChampSaisie is the basic, ancestor data entry field }π TChampSaisie =π Object(TObject)π Contenu : String ; { content during keyboard input }π x, y, { screen coordinates }π Largeur, { on-screen width of field }π Taille, { size of the field }π AttrActif, { active field colors }π AttrPassif : Byte ; { passive field colors }π Variable : Pointer ; { pointer to variable to fill }π EffaceAuto : Boolean ; { True if automatic clearing }ππ Constructor Init( _x, _y : Integer ;π _Largeur : Integer ;π _Taille : Integer ;π _AttrActif,π _AttrPassif : Integer ;π Var _Variable) ;ππ { Dessine draws the entry field on screen. Decalage is anπ optional shifting (if content is wider than screen field) }π Procedure Dessine( Actif : Boolean ;π Decalage : Integer) ; Virtual ;ππ { Runs the data entry. Returns the code of the key used to exit. }π Function Execute : Word ; Virtual ;ππ { Reads a key from keyboard. May be redefined by child objects,π for instance to handle the mouse. }π Function LitTouche : Word ; Virtual ;ππ { Checks whether or not a key is valid or not, given cursor pos.π Should be redefined for numeric fields, etc... }π Function ToucheValide( Position : Integer ;π Touche : Word) : Boolean ; Virtual ;ππ { Handles the key. Returns True if the key was accepted. }π Function GereTouche(Var Position : Integer ;π Var Touche : Word) : Boolean ; Virtual ;ππ { Reads the content of the user variable (pointed to byπ Variable) to Contenu. }π Procedure LitResultat ; Virtual ;ππ { Moves Contenu to the user variable. }π Procedure EcritResultat ; Virtual ;ππ { Checks whether Contenu's (what the user typed!) is valid. }π Function ContenuValide : Boolean ; Virtual ;π End ;π PChampSaisie = ^TChampSaisie ;ππ { The next objects are specialized childrens of TChampSaisie. Now,π what is OOP for ? ;-) }ππ { TChampLongint specializes in handling LongInt input. }π TChampLongInt =π Object(TChampSaisie)π Function ToucheValide( Position : Integer ;π Touche : Word) : Boolean ; Virtual ;π Procedure LitResultat ; Virtual ;π Procedure EcritResultat ; Virtual ;π Function ContenuValide : Boolean ; Virtual ;π End ;π PChampLongInt = ^TChampLongInt ;ππ { TChampOctet is done to handle Byte input. }π TChampOctet =π Object(TChampLongInt)π Mini,π Maxi : Byte ;ππ Constructor Init( _x, _y : Integer ;π _Largeur : Integer ;π _Taille : Integer ;π _AttrActif,π _AttrPassif : Integer ;π _Mini, _Maxi : Byte ;π Var _Variable : Byte) ;π Procedure LitResultat ; Virtual ;π Procedure EcritResultat ; Virtual ;π Function ContenuValide : Boolean ; Virtual ;π End ;π PChampOctet = ^TChampOctet ;ππ { TChampMajuscules will uppercase what the user types in. }π TChampMajuscules =π Object(TChampSaisie)π Function GereTouche(Var Position : Integer ;π Var Touche : Word) : Boolean ; Virtual ;π End ;π PChampMajuscules = ^TChampMajuscules ;ππ { TChampChoixListe will let the user make a choice within a definedπ list. See the 'Sex' field in TEST.PAS. }π TChampChoixListe =π Object(TChampSaisie)π Liste : PListeChaines ; { choices list }π Courant : Integer ; { current choice }ππ { _Variable contains (and will be so updated) the index of theπ selected entry in the _Liste list of choices. }π Constructor Init( _x, _y : Integer ;π _Largeur : Integer ;π _AttrActif,π _AttrPassif : Integer ;π _Liste : PListeChaines ;π Var _Variable : Integer) ;π Function ToucheValide( Position : Integer ;π Touche : Word) : Boolean ; Virtual ;π Function GereTouche(Var Position : Integer ;π Var Touche : Word) : Boolean ; Virtual ;π Procedure LitResultat ; Virtual ;π Procedure EcritResultat ; Virtual ;ππ Privateππ Procedure MetAJourContenu ;π End ;π PChampChoixListe = ^TChampChoixListe ;ππ { TChampPChar will let you input a ASCIIZ string. }π TChampPChar =π Object(TChampSaisie)π Procedure LitResultat ; Virtual ;π Procedure EcritResultat ; Virtual ;π End ;π PChampPChar = ^TChampPChar ;ππ { TChampBoolean handles Boolean fields input. }π TChampBooleen =π Object(TChampSaisie)π Constructor Init( _x, _y : Integer ;π _AttrActif,π _AttrPassif : Integer ;π Var _Variable : Boolean) ;π Function ToucheValide( Position : Integer ;π Touche : Word) : Boolean ; Virtual ;π Function GereTouche(Var Position : Integer ;π Var Touche : Word) : Boolean ; Virtual ;π Procedure LitResultat ; Virtual ;π Procedure EcritResultat ; Virtual ;π End ;π PChampBooleen = ^TChampBooleen ;ππ { TGroupeSaisie is a collection of TChampSaisie. The Execute methodπ will handle cycling through entry fields, etc... }π TGroupeSaisie =π Object(TCollection)π Function Execute : Word ;π End ;π PGroupeSaisie = ^TGroupeSaisie ;ππ{ Utilities }πFunction Complete(St : OpenString ; Len : Integer) : String ;πFunction LitClavier : Integer ;ππ{--------------------------------------------------------------------------}π{--------------------------------------------------------------------------}ππImplementationππUses DOS,π Strings,π{$IfDef OS2}π OS2Subs,π{$EndIf}π CRT ;ππ{-----------------------------------------------------------------------------}ππFunction LitClavier : Integer ;πVar t : Word ;πBeginπ t:=Ord(ReadKey) ;π If t=0 Then t:=Ord(ReadKey) ShL 8 ;π LitClavier:=t ;πEnd ;ππFunction Complete(St : OpenString ; Len : Integer) : String ;πVar i : Integer ;πBeginπ For i:=Length(St)+1 To Len Do St[i]:=' ' ;π St[0]:=Chr(Len) ;π Complete:=St ;πEnd ;ππConstructor TChampSaisie.Init ;πBeginπ x:=_x ;π y:=_y ;π Largeur:=_Largeur ;π If (Largeur<0) Or (Largeur>80) Then Fail ;π Taille:=_Taille ;π AttrActif:=_AttrActif ;π AttrPassif:=_AttrPassif ;π Variable:=Addr(_Variable) ;π EffaceAuto:=True ;ππ LitResultat ;π If Length(Contenu)>Taille Thenπ Contenu:=Copy(Contenu, 1, Taille) ;πEnd ;ππProcedure TChampSaisie.Dessine ;πVar St : String ;πBeginπ If Actif Then TextAttr:=AttrActifπ Else TextAttr:=AttrPassif ;π St:=Copy(Contenu, Decalage, Largeur) ;π If Length(St)<Largeur Then St:=Complete(St, Largeur) ;π{$IfDef OS2}π VioWrtCharStrAtt( @St[1], Length(St),π y+Hi(WindMin)-1, x+Lo(WindMin)-1,π TextAttr, 0) ;π{$Else}π GoToXY(x, y) ;π Write(St) ;π{$EndIf}πEnd ;ππFunction TChampSaisie.Execute ;πVar Touche : Word ;π Position : Integer ;π Decalage : Integer ;π Termine : Boolean ;π Premiere : Boolean ;πBeginπ Decalage:=1 ;π Position:=1 ;π Termine:=False ;π Premiere:=True ;ππ Repeatπ Dessine(True, Decalage) ;π GoToXY(x-Decalage+Position, y) ;π Touche:=LitTouche ;π If EffaceAuto Thenπ If Premiere Thenπ If (Touche>31) And (Touche<256) Thenπ If ToucheValide(Position, Touche) Then Contenu:='' ;π Premiere:=False ;π If Not GereTouche(Position, Touche) Thenπ { A-t-on terminé ? }π If (Touche<32) Or (Touche>255) Then Termine:=True ;π { Adaptons Decalage à Position }π If Position<Decalage Then Decalage:=Position ;π If Position>=(Decalage+Largeur) Then Decalage:=Position-Largeur+1 ;ππ If Termine Thenπ Beginπ Termine:=ContenuValide ;π If Not Termine Thenπ Beginπ{$IfDef OS2}π PlaySound(300, 200) ;π{$Else}π Sound(300) ;π Delay(200) ;π NoSound ;π{$EndIf}π End ;π End ;π Until Termine ;ππ If Touche<>kbEchap Then EcritResultatπ Else LitResultat ;π Dessine(False, 1) ;π Execute:=Touche ;πEnd ;ππFunction TChampSaisie.LitTouche ;πBeginπ LitTouche:=LitClavier ;πEnd ;ππFunction TChampSaisie.ToucheValide ;πBeginπ ToucheValide:=True ;πEnd ;ππFunction TChampSaisie.ContenuValide ;πBeginπ ContenuValide:=True ;πEnd ;ππFunction TChampSaisie.GereTouche ;πBeginπ GereTouche:=True ;π If ToucheValide(Position, Touche) Thenπ Beginπ Case Touche Ofπ 32..255 :π Beginπ Insert(Chr(Touche), Contenu, Position) ;π If Length(Contenu)>Taille Then Dec(Contenu[0]) ;π If Position<Taille Then Inc(Position) ;π End ;π kbCtrlD,π kbDroite :π Beginπ If Position<=Length(Contenu) Then Inc(Position) ;π If Position>Taille Then Dec(Position) ;π End ;π kbGauche :π Beginπ If Position>1 Then Dec(Position) ;π End ;π kbRetour :π Beginπ If Position>1 Thenπ Beginπ Dec(Position) ;π Delete(Contenu, Position, 1) ;π End ;π End ;π kbSuppr :π Beginπ If Position<=Length(Contenu) Thenπ Beginπ Delete(Contenu, Position, 1) ;π End ;π End ;π kbFin : Position:=Length(Contenu)+1 ;π kbDebut : Position:=1 ;π kbCtrlY :π Beginπ Contenu:='' ;π Position:=1 ;π End ;π kbCtrlT :π Beginπ While (Position<Length(Contenu)) Andπ (Contenu[Position] In Caracteres) Doπ Delete(Contenu, Position, 1) ;π If Position<=Length(Contenu) Thenπ Delete(Contenu, Position, 1) ;π End ;π kbCtrlGauche :π Beginπ If Position>1 Then Dec(Position) ;π While (Position>1) Andπ (Contenu[Position-1] In Caracteres) Do Dec(Position) ;π End ;π kbCtrlDroite :π Beginπ While (Position<Length(Contenu)) Andπ (Contenu[Position] In Caracteres) Do Inc(Position) ;π If Position<=Length(Contenu) Then Inc(Position) ;π If Position>Taille Then Dec(Position) ;π End ;π Else GereTouche:=False ;π End ;π End Elseπ Beginπ{$IfDef OS2}π PlaySound(1000, 100) ;π{$Else}π Sound(1000) ;π Delay(100) ;π NoSound ;π{$EndIf}π End ;πEnd ;ππProcedure TChampSaisie.LitResultat ;πBeginπ Move(Variable^, Contenu, Taille+1) ;πEnd ;ππProcedure TChampSaisie.EcritResultat ;πBeginπ Move(Contenu, Variable^, Length(Contenu)+1) ;πEnd ;ππ{-------------------------------------- TGroupeSaisie ------------------------}ππFunction TGroupeSaisie.Execute ;ππ Procedure Affiche(Champ : PChampSaisie) ; Far ;π Beginπ Champ^.Dessine(False, 1) ;π End ;ππVar Touche : Word ;π Courant : Integer ;π Termine : Boolean ;ππBeginπ ForEach(@Affiche) ;ππ Termine:=Count=0 ;π Courant:=0 ;π Touche:=kbEchap ;ππ Repeatπ Touche:=PChampSaisie(At(Courant))^.Execute ;π Case Touche Ofπ kbHaut :π Beginπ Dec(Courant) ;π If Courant<0 Then Courant:=Pred(Count) ;π End ;π kbEntree,π kbTab,π kbBas :π Beginπ Inc(Courant) ;π If Courant>=Count Then Courant:=0 ;π End ;π kbPageHaut,π kbPageBas,π kbEchap,π kbCtrlEntree :π Beginπ Termine:=True ;π End ;π End ;π Until Termine ;ππ Execute:=Touche ;πEnd ;ππ{-------------------------------------- TChampLongInt ------------------------}ππFunction TChampLongInt.ToucheValide ;πBeginπ ToucheValide:=(Touche<32) Or (Touche>255) Orπ ((Touche>=Ord('0')) And (Touche<=Ord('9'))) ;πEnd ;ππProcedure TChampLongInt.LitResultat ;πType PLongInt = ^LongInt ;π3Beginπ Str(PLongInt(Variable)^, Contenu) ;πEnd ;ππProcedure TChampLongInt.EcritResultat ;πType PLongInt = ^LongInt ;πVar Err : Integer ;πBeginπ Val(Contenu, PLongInt(Variable)^, Err) ;πEnd ;ππFunction TChampLongInt.ContenuValide ;πType PLongInt = ^LongInt ;πVar Err : Integer ;πBeginπ Val(Contenu, PLongInt(Variable)^, Err) ;π ContenuValide:=Err=0 ;πEnd ;ππ{-------------------------------------- TChampOctet --------------------------}ππConstructor TChampOctet.Init ;πBeginπ Mini:=_Mini ;π Maxi:=_Maxi ;π If Not Inherited Init(_x, _y, _Largeur, _Largeur, _AttrActif,π _AttrPassif, _Variable) Then Fail ;π If Not ContenuValide Thenπ Beginπ _Variable:=Mini ;π LitResultat ;π End ;πEnd ;ππProcedure TChampOctet.LitResultat ;πType PByte = ^Byte ;πBeginπ Str(PByte(Variable)^, Contenu) ;πEnd ;ππProcedure TChampOctet.EcritResultat ;πType PByte = ^Byte ;πVar Err : Integer ;πBeginπ Val(Contenu, PByte(Variable)^, Err) ;πEnd ;ππFunction TChampOctet.ContenuValide ;πType PByte = ^Byte ;πVar Err : Integer ;πBeginπ Val(Contenu, PByte(Variable)^, Err) ;π ContenuValide:=(Err=0) Andπ (PByte(Variable)^>=Mini) Andπ (PByte(Variable)^<=Maxi) ;πEnd ;ππ{-------------------------------------- TChampMajuscules ------------------}π{ This should give you ideas if you need input masks... }ππFunction TChampMajuscules.GereTouche ;πBeginπ If (Touche>=Ord('a')) And (Touche<=Ord('z')) Then Dec(Touche, 32) ;π GereTouche:=Inherited GereTouche(Position, Touche) ;πEnd ;ππ{-------------------------------------- TListeChaines ------------------------}ππProcedure TListeChaines.FreeItem ;πBeginπ If Item<>Nil Then DisposeStr(PString(Item)) ;πEnd ;ππ{-------------------------------------- TChampChoixListe ---------------------}ππConstructor TChampChoixListe.Init ;πBeginπ Liste:=_Liste ;π If Not Inherited Init(_x, _y, _Largeur, _Largeur, _AttrActif,π _AttrPassif, _Variable) Then Fail ;πEnd ;ππProcedure TChampChoixListe.LitResultat ;πType PInteger = ^Integer ;πBeginπ Courant:=PInteger(Variable)^ ;π If (Courant<0) Orπ (Courant>=Liste^.Count) Then Courant:=0 ;π MetAJourContenu ;πEnd ;ππProcedure TChampChoixListe.EcritResultat ;πType PInteger = ^Integer ;πBeginπ PInteger(Variable)^:=Courant ;πEnd ;ππFunction TChampChoixListe.ToucheValide ;πBeginπ ToucheValide:=(Touche<32) Or (Touche>255) ;πEnd ;ππFunction TChampChoixListe.GereTouche ;πBeginπ GereTouche:=True ;π If ToucheValide(Position, Touche) Thenπ Beginπ Case Touche Ofπ kbDroite :π Beginπ Inc(Courant) ;π If Courant>=Liste^.Count Then Courant:=0 ;π MetAJourContenu ;π End ;π kbGauche :π Beginπ Dec(Courant) ;π If Courant<0 Then Courant:=Pred(Liste^.Count) ;π MetAJourContenu ;π End ;π Else GereTouche:=False ;π End ;π End Elseπ Beginπ{$IfDef OS2}π PlaySound(1000, 100) ;π{$Else}π Sound(1000) ;π Delay(100) ;π NoSound ;π{$EndIf}π End ;πEnd ;ππProcedure TChampChoixListe.MetAJourContenu ;πVar Tmp : String[80] ;πBeginπ If Liste^.At(Courant)=Nilπ Then Tmp:=''π Else Tmp:=Copy(PString(Liste^.At(Courant))^, 1, Largeur-2) ;π Contenu:=#17+Complete(Tmp, Largeur-2)+#16 ;πEnd ;ππ{-------------------------------------- TChampPChar --------------------------}ππProcedure TChampPChar.LitResultat ;πBeginπ Contenu:=StrPas(Variable) ;πEnd ;ππProcedure TChampPChar.EcritResultat ;πBeginπ StrPCopy(Variable, Contenu) ;πEnd ;ππ{-------------------------------------- TChampBooleen ------------------------}ππConstructor TChampBooleen.Init ;πBeginπ If Not Inherited Init(_x, _y, 3, 3, _AttrActif,π _AttrPassif, _Variable) Then Fail ;π EffaceAuto:=False ;πEnd ;ππFunction TChampBooleen.ToucheValide ;πBeginπ ToucheValide:=(Touche<=32) Or (Touche>255) ;πEnd ;ππFunction TChampBooleen.GereTouche ;πBeginπ If (Touche=32) Orπ (Touche=kbDroite) Orπ (Touche=kbGauche) Thenπ Beginπ GereTouche:=True ;π If Contenu[2]=' ' Then Contenu[2]:='■'π Else Contenu[2]:=' ' ;π End Elseπ Beginπ GereTouche:=Inherited GereTouche(Position, Touche) ;π End ;πEnd ;ππProcedure TChampBooleen.LitResultat ;πType PBoolean = ^Boolean ;πBeginπ If PBoolean(Variable)^ Then Contenu:='[■]'π Else Contenu:='[ ]' ;πEnd ;ππProcedure TChampBooleen.EcritResultat ;πType PBoolean = ^Boolean ;πBeginπ PBoolean(Variable)^:=Contenu[2]<>' ' ;πEnd ;ππEnd.ππ{ --------------------- DEMO ----------------------------}π{ Example for the SAISIE unit. Raphaël Vanney, 07/94 }ππ{$d+,l+,x+}ππUses CRT,π Saisie,π Strings,π Objects,π DOS ;ππVar Test : PGroupeSaisie ;ππ Enreg :π Recordπ LastName : String[30] ;π FirstName : String[30] ;π Address : String[100] ;π ZipCode : LongInt ;π City : String[30] ;π Sex : Integer ;π End ;π Liste : PListeChaines ;ππBeginπ ClrScr ;π TextColor(LightCyan) ;π TextBackGround(Blue) ;ππ FillChar(Enreg, SizeOf(Enreg), #0) ;π TextColor(LightGreen) ;π GoToXY(1, 1) ;π Write('^Enter to validate') ;ππ Liste:=New(PListeChaines, Init(2, 2)) ;π Liste^.Insert(NewStr('Unknown')) ;π Liste^.Insert(NewStr('Male')) ;π Liste^.Insert(NewStr('Female')) ;ππ Test:=New(PGroupeSaisie, Init(2, 2)) ;π With Enreg Doπ Beginπ GoToXY(1, 10) ; Write('Last name : ') ;π Test^.Insert(New(PChampMajuscules, Init(12, 10,π 20,π SizeOf(LastName)-1,π (Blue ShL 4)+White,π (Blue ShL 4)+LightGray,π LastName))) ;π GoToXY(1, 11) ; Write('FirstName : ') ;π Test^.Insert(New(PChampSaisie, Init(12, 11,π 20,π SizeOf(FirstName)-1,π (Blue ShL 4)+White,π (Blue ShL 4)+LightGray,π FirstName))) ;π GoToXY(1, 12) ; Write('Address : ') ;π Test^.Insert(New(PChampSaisie, Init(12, 12,π 20,π SizeOf(Address)-1,π (Blue ShL 4)+White,π (Blue ShL 4)+LightGray,π Address))) ;π GoToXY(1, 13) ; Write('Zip code : ') ;π Test^.Insert(New(PChampLongInt, Init( 12, 13,π 6,π 5,π (Blue ShL 4)+White,π (Blue ShL 4)+LightGray,π ZipCode))) ;π GoToXY(1, 14) ; Write('City : ') ;π Test^.Insert(New(PChampMajuscules, Init(12, 14,π 20,π SizeOf(City)-1,π (Blue ShL 4)+White,π (Blue ShL 4)+LightGray,π City))) ;π GoToXY(1, 15) ; Write('Sex : ') ;π Test^.Insert(New(PChampChoixListe, Init(12, 15,π 20,π (Blue ShL 4)+White,π (Blue ShL 4)+LightGray,π Liste,π Sex))) ;π End ;ππ Test^.Execute ;π Dispose(Liste, Done) ;π Dispose(Test, Done) ;ππ GoToXY(1, 18) ;π TextAttr:=LightGray ;π With Enreg Doπ Beginπ WriteLn('LastName =', LastName) ;π WriteLn('FirstName =', FirstName) ;π WriteLn('Address =', Address) ;π WriteLn('ZipCode =', ZipCode) ;π WriteLn('City =', City) ;π WriteLn('Sex =', Sex) ;π End ;πEnd.π 3 08-25-9409:06ALL PETER NEUENDORFFER Data Entry Routines SWAG9408 ;½╖Ω 59 3 {πWell, this code outlines your problem and it's solution. I assumeπyou have a single string input procedure. However, why don't you justπposition several strings on the screen? The techinique I've outlinedπis legit, but a little cumbersome:π(in two messages}π{Regarding your request for a form input technique, I do not knowπof a library that handles this, although there probably is one.πSuch an object (in the loose sense of the word) could be written inπTurbo Pascal, given a string input handler that you have the sourceπto so you could modify the exit keys.π Imagine a procedure getstring that sets single string input thatπreturns the string when Enter or Tab is pressed, sets a list to "commit"πwhen enter is pressed as well, and sets a list to "cancel" when escapeπisπpressed. Now you can set up a global record structure and skeletonπfor form input like so}πprogram formit;πuses crt;π typeπ single_string=recordπ startx,starty:byte; {start coordinates of each caption}π caption:string; {the caption for the string}π str:string; {the single string you are getting}π max_permitted:byte; {maximum length of field}π end;ππ {an array storing the strings in the forms and their placeπ on the screen}π form_array_type=array[1..30] of single_string;ππ {exit status for each string entered}π exitlist=(nocode,tabstop,cancel,commit);ππ varπ form_array:form_array_type; {our form with it's strings}π no_strings_in_form:byte; {how many active strings in form}π exitcode:exitlist;π x:byte;π Procedure getstring(var input_string:string;max_permitted:π byte;var exitcode:π exitlist);π Beginπ {single string input procedure}π {doen't care about the form structure}ππ End;π {SUB PROCEDURE SHOW_FORM}π procedure show_form(form_array:form_array_type;π no_strings_in_form:byte);π varπ x:byte;π beginπ for x:=1 to no_strings_in_form doπ beginπ gotoxy(form_array[x].startx,form_array[x].starty);π write(form_array[x].caption);π end;π end;π {SUB PROCEDURE GET_FORM}ππ Procedure Get_form(var form_array:form_array_type;π no_items:byte; var exitcode:exitlist);π varπ form_array_index:byte;π current_string:string;π max_permitted:byte;π {SUB} procedure get_first_tab; {find top left string}π {THESE SCAN PROCEDURES MAY SEEM A LITTLE OBSCURE,π THEY ARE DESIGNED TO FIND THE NEXT STRINGπ AND NEED TO BE DEBUGGED}π varπ x:byte;π lastx,lasty:byte;π beginπ form_array_index:=1;π lastx:=form_array[1].startx;π lasty:=form_array[1].starty;π for x:=2 to no_items doπ if (form_array[x].starty<=lasty) andπ (form_array[x].startx<=lastx) thenπ beginπ lasty:=form_array[x].starty;π lastx:=form_array[x].startx;π form_array_index:=x;π end;π end;ππ {SUB} procedure get_next_tab;π varπ found:boolean;π x,lastx,lasty:byte;π last_form_array_index:byte;π beginπ found:=false;π last_form_array_index:=form_array_index;π lastx:=200;π lasty:=200; {force values}π for x:=1 to no_items doπ ifπ (x<>last_form_array_index) andπ (form_array[x].starty<=lasty)π andπ (form_array[x].startx<=lastx)π andπ (form_array[x].starty>=π form_array[last_form_array_index].starty)π andπ (form_array[x].startx>=π form_array[last_form_array_index].startx)π thenπ beginπ form_array_index:=x;π lasty:=form_array[form_array_index]π .starty;π lastx:=form_array[form_array_index].π startx;π found:=true;π end;π if not found thenπ get_first_tab;π end;π Beginπ {1. ? find the top left byπ scanning the startx, starty of form_array}π get_first_tab;π REPEATππ {2. Now write the string and get the new string}π gotoxy(form_array[form_array_index].startx,π form_array[form_array_index].starty);π write(form_array[form_array_index].caption,π form_array[form_array_index].str);π gotoxy(form_array[form_array_index].startx+π length(form_array[form_array_index].caption),π form_array[form_array_index].starty);ππ current_string:=form_array[form_array_index].str;π max_permitted:=form_array[form_array_index].π max_permitted;π exitcode:=nocode;π {3. } Getstring(current_string,max_permitted,exitcode);ππ form_array[form_array_index].str:=current_string;ππ {4. ? find the next placedπ string to tab to by scanning the startx,π starty of form array}π if exitcode = tabstop thenπ beginπ {? depends on x/y order in array};π get_next_tab;π end;ππ UNTIL exitcode in [cancel,commit];π End; {get_form}ππ Begin {Calling procedure}π {initialize array only has to be done once for the formπ within scope}π no_strings_in_form:=5;π form_array[1].startx:=1;π form_array[1].starty:=3;π form_array[1].caption:='Name ';π form_array[1].str:='';π form_array[1].max_permitted:=20;π form_array[2].startx:=1;π form_array[2].starty:=4;π form_array[2].caption:='Address ';π form_array[2].str:='';π form_array[2].max_permitted:=60;π {ETCETERA}π {care must be taken not to overlap captions and strings}ππ {the array is passed to the form input handler}π clrscr;π show_form(form_array,no_strings_in_form);π Get_form(form_array,no_strings_in_form,exitcode);ππ {the new values of the strings are returned inπ the array form_array, in each .str field}π End.π
